#include <tcl.h>

#include "f_core.h"
#include "f_varops.h"

#include "debug.h"
#include "inspect.h"

/* поместить объект в переменную varName
    имя переменной может задаваться как объект Tcl (что приоритетно) или как asciiz строка
    если opcode равен 0, то элементы добавляются в конец объекта (операция put)
    иначе - добавляются в начало (операция push)
    ---
*/
Tcl_Obj *
varAdd(Tcl_Interp *interp,int opcode,Tcl_Obj *varNameAsObj,char *varNameAsString,Tcl_Obj *obj)
{
    Tcl_Obj *valueObj;
    int needSetValue=0; // = надо ли по завершению редактирования устанавливать новое значение
    
    valueObj=NULL;
    /* получить прежнее значение переменной */
    if (varNameAsObj!=NULL) {
        valueObj=Tcl_ObjGetVar2(interp,varNameAsObj,NULL,0);
    } else if (varNameAsString!=NULL) {
        valueObj=Tcl_GetVar2Ex(interp,varNameAsString,NULL,0);
    } else {
        ERR("no var.name given");
        goto ERROR;
    }
    /* TODO: посмотреть - может есть такой файл и надо передать объект в файл */
    if (valueObj==NULL) {
        // такой переменной ранее не было - просто создать новую со значением tupleObj
        if (varNameAsObj!=NULL) {
            if (Tcl_ObjSetVar2(interp,varNameAsObj,NULL,obj,0)==NULL) {
                ERR("unable to set var");
                goto ERROR;
            }
        } else /* if (varNameAsString!=NULL) */ {
            if (Tcl_SetVar2Ex(interp,varNameAsString,NULL,obj,0)==NULL) {
                ERR("unable to set var");
                goto ERROR;
            }
        }
        return TCL_OK;
    }
    if (valueObj->typePtr==lazyType) {
        // lazy необходимо обернуть в tuple чтобы к нему что-то добавлять
        needSetValue=1;
        valueObj=tupleObjFromAny(interp,valueObj);
        Tcl_IncrRefCount(valueObj);
    }
    if (Tcl_IsShared(valueObj)) {
        // если исходное значение зашарено, то нужен дубликат
        needSetValue=1;
        valueObj=Tcl_DuplicateObj(valueObj);
        Tcl_IncrRefCount(valueObj);
    }
    if ((obj->typePtr==tupleType || obj->typePtr==lazyType) && valueObj->typePtr!=tupleType)  {
        // tuple и lazy - сильные типы и надо конвертироваться в них
        if (Tcl_ConvertToType(interp,valueObj,tupleType)!=TCL_OK) {
            goto ERROR;
        }
    }
    /** редактирование наконец-таки **/
    if (opcode==0) {
        // операция put - добавляем данные в конец
        if (valueObj->typePtr==tupleType) {
            tupleObjPut(interp,valueObj,obj);
        } else {
            Tcl_ListObjAppendList(interp,valueObj,obj);
        }
    } else {
        // операция push - добавляем данные в начало
        if (valueObj->typePtr==tupleType) {
            tupleObjPush(interp,valueObj,obj);
        } else {
            int objc;
            Tcl_Obj **objv;
            if (Tcl_ListObjGetElements(interp,obj,&objc,&objv)!=TCL_OK) goto ERROR;
            if (Tcl_ListObjReplace(interp,valueObj,0,0,objc,objv)!=TCL_OK) goto ERROR;
        }
    }
    /** если исходное значение было зашарено, то необходимо задать новое **/
    if (needSetValue) {
        if (varNameAsObj!=NULL) {
            if (Tcl_ObjSetVar2(interp,varNameAsObj,NULL,valueObj,0)==NULL) {
                ERR("unable to set var");
                goto ERROR;
            }
        } else /* if (varNameAsString!=NULL) */ {
            if (Tcl_SetVar2Ex(interp,varNameAsString,NULL,valueObj,0)==NULL) {
                ERR("unable to set var");
                goto ERROR;
            }
        }
        Tcl_DecrRefCount(valueObj);
    } else {
        Tcl_InvalidateStringRep(valueObj);
    }
    return valueObj;
ERROR:
    if (needSetValue && valueObj!=NULL) Tcl_DecrRefCount(valueObj);
    return NULL;
}

/* получить элементы из переменной
*/
Tcl_Obj *
varGet(Tcl_Interp *interp,Tcl_Obj *nameAsObj,char *nameAsString,int count)
{
    Tcl_Obj *value;
    Tcl_Obj *result;
    int needSetValue=0;
    /* получить текущее значение переменной */
    if (nameAsObj!=NULL) {
        value=Tcl_ObjGetVar2(interp,nameAsObj,NULL,0);
    } else if (nameAsString!=NULL) {
        value=Tcl_GetVar2Ex(interp,nameAsString,NULL,0);
    } else {
        ERR("no var.name given");
        goto ERROR;
    }
    /* если значение не получено (нет такой переменной) вернуть пустой кортеж */
    if (value==NULL) {
        return tupleObjNew();
    }
    /* count=0 подразумевает вернуть всё, ничего не оставить */
    if (count==0) {
        if (nameAsObj!=NULL) {
            if (Tcl_ObjSetVar2(interp,nameAsObj,NULL,tupleObjNew(),0)==NULL) {
                ERR("unable to set var");
                goto ERROR;
            }
        } else /* if (nameAsString!=NULL) */ {
            if (Tcl_SetVar2Ex(interp,nameAsString,NULL,tupleObjNew(),0)==NULL) {
                ERR("unable to set var");
                goto ERROR;
            }
        }
        return value;
    }
    /* если текущее значение lazy - то его надо обернуть в tuple чтобы что-то отнимать */
    if (value->typePtr==lazyType) {
        needSetValue=1;
        value=tupleObjFromAny(interp,value);
        Tcl_IncrRefCount(value);
    }
    /* если значение зашарено - то надо использовать копию */
    if (Tcl_IsShared(value)) {
        needSetValue=1;
        value=Tcl_DuplicateObj(value);
        Tcl_IncrRefCount(value);
    }
    /* теперь можно забирать элементы */
    if (value->typePtr==tupleType) {
        Tcl_Obj *element;
        result=tupleObjNew();
        while((element=tupleObjGet(interp,value,0))!=NULL) {
            tupleObjPut(interp,result,element);
            count--;
            if (count==0) break;
        }
    } else {
        int objc;
        Tcl_Obj **objv;
        
        if (Tcl_ListObjGetElements(interp,value,&objc,&objv)!=TCL_OK) {
            ERR("no access to value elements");
            goto ERROR;
        }
        
        if (objc>count) objc=count;
        result=Tcl_NewListObj(objc,objv);
        
        if (Tcl_ListObjReplace(interp,value,0,count,0,NULL)!=TCL_OK) {
            ERR("unable to remove elements");
            // goto ERROR;
        }
    }
    /* если прежнее значение было зашарено - надо задавать новое */
    if (needSetValue) {
        if (nameAsObj!=NULL) {
            if (Tcl_ObjSetVar2(interp,nameAsObj,NULL,value,0)==NULL) {
                ERR("unable to set var");
                goto ERROR;
            }
        } else /* if (nameAsString!=NULL) */ {
            if (Tcl_SetVar2Ex(interp,nameAsString,NULL,value,0)==NULL) {
                ERR("unable to set var");
                goto ERROR;
            }
        }
        Tcl_DecrRefCount(value);
    } else {
        Tcl_InvalidateStringRep(value);
    }
    return result;
ERROR:
    if (needSetValue && value!=NULL) Tcl_DecrRefCount(value);
    if (result!=NULL) Tcl_DecrRefCount(result);
    return NULL;
}

/* tcl : vput varName value
*/
int
vputObjCmd(ClientData data,Tcl_Interp *interp,int objc,Tcl_Obj *const objv[])
{
    Tcl_Obj *result;
    (void)data;
    if (objc!=3) {
        Tcl_WrongNumArgs(interp,objc,objv,"varName value");
        return TCL_ERROR;
    }
    result=varPut(interp,objv[1],NULL,objv[2]);
    if (result==NULL) {
        return TCL_ERROR;
    }
    Tcl_SetObjResult(interp,result);
    return TCL_OK;
}

/* tcl : vpush varName value
*/
int
vpushObjCmd(ClientData data,Tcl_Interp *interp,int objc,Tcl_Obj *const objv[])
{
    Tcl_Obj *result;
    (void)data;
    if (objc!=3) {
        Tcl_WrongNumArgs(interp,objc,objv,"varName value");
        return TCL_ERROR;
    }
    result=varPush(interp,objv[1],NULL,objv[2]);
    if (result==NULL) {
        return TCL_ERROR;
    }
    Tcl_SetObjResult(interp,result);
    return TCL_OK;
}
/* tcl : vget varName ?count?
*/
int
vgetObjCmd(ClientData data,Tcl_Interp *interp,int objc,Tcl_Obj *const objv[])
{
    Tcl_Obj *result;
    int count;
    (void)data;
    if (objc==2) {
        count=1;
    } else if (objc==3) {
        if (Tcl_GetIntFromObj(interp,objv[2],&count)!=TCL_OK || count<0) {
            Tcl_SetResult(interp,"count should be a positive integer",NULL);
            return TCL_ERROR;
        }
    } else {
        Tcl_WrongNumArgs(interp,objc,objv,"varName ?count?");
        return TCL_ERROR;
    }
    result=varGet(interp,objv[1],NULL,count);
    if (result==NULL) {
        return TCL_ERROR;
    }
    Tcl_SetObjResult(interp,result);
    return TCL_OK;
}